home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / gnats / send-pr.el.z / send-pr.el
Encoding:
Text File  |  1998-05-21  |  28.4 KB  |  809 lines
  1. ;;;; -*-emacs-lisp-*-
  2. ;;;;---------------------------------------------------------------------------
  3. ;;;;    EMACS interface for send-pr (by Heinz G. Seidl, hgs@cygnus.com)
  4. ;;;;    Slightly hacked by Brendan Kehoe (brendan@cygnus.com).
  5. ;;;;
  6. ;;;;    This file is part of the Problem Report Management System (GNATS)
  7. ;;;;    Copyright 1992, 1993 Cygnus Support
  8. ;;;;
  9. ;;;;    This program is free software; you can redistribute it and/or
  10. ;;;;    modify it under the terms of the GNU General Public
  11. ;;;;    License as published by the Free Software Foundation; either
  12. ;;;;    version 2 of the License, or (at your option) any later version.
  13. ;;;;
  14. ;;;;    This program is distributed in the hope that it will be useful,
  15. ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17. ;;;;    General Public License for more details.
  18. ;;;;
  19. ;;;;    You should have received a copy of the GNU Library General Public
  20. ;;;;    License along with this program; if not, write to the Free
  21. ;;;;    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22. ;;;;
  23. ;;;;---------------------------------------------------------------------------
  24. ;;;;
  25. ;;;;    This file contains the EMACS interface to the Problem Report Management
  26. ;;;;    System (GNATS):
  27. ;;;;
  28. ;;;;        - The `send-pr' command and the `send-pr-mode' for sending 
  29. ;;;;              Problem Reports (PRs).
  30. ;;;;
  31. ;;;;    For more information about how to send a PR see send-pr(1).
  32. ;;;;
  33. ;;;;---------------------------------------------------------------------------
  34. ;;;;
  35. ;;;;    Configuration: the symbol `DEFAULT-RELEASE' can be replaced by
  36. ;;;;    site/release specific strings during the configuration/installation
  37. ;;;;    process.
  38. ;;;;
  39. ;;;;    Install this file in your EMACS library directory.
  40. ;;;;
  41. ;;;;---------------------------------------------------------------------------
  42.  
  43. (provide 'send-pr)
  44.  
  45. ;;;;---------------------------------------------------------------------------
  46. ;;;; Customization: put the following forms into your default.el file
  47. ;;;; (or into your .emacs)
  48. ;;;;---------------------------------------------------------------------------
  49.  
  50. ;(autoload 'send-pr-mode "send-pr"
  51. ;      "Major mode for sending problem reports." t)
  52.  
  53. ;(autoload 'send-pr "send-pr"
  54. ;            "Command to create and send a problem report." t)
  55.  
  56. ;;;;---------------------------------------------------------------------------
  57. ;;;; End of Customization Section
  58. ;;;;---------------------------------------------------------------------------
  59.  
  60. (autoload 'server-buffer-done "server")
  61. (defvar server-buffer-clients nil)
  62. (defvar mail-self-blind nil)
  63. (defvar mail-default-reply-to nil)
  64.  
  65. (defconst send-pr::version "3.101")
  66.  
  67. (defvar gnats:root "/usr/share/gnats/gnats-db"
  68.   "*The top of the tree containing the GNATS database.")
  69.  
  70. ;;;;---------------------------------------------------------------------------
  71. ;;;; hooks
  72. ;;;;---------------------------------------------------------------------------
  73.  
  74. (defvar text-mode-hook nil)   ; we define it here in case it's not defined
  75. (defvar send-pr-mode-hook text-mode-hook "Called when send-pr is invoked.")
  76.  
  77. ;;;;---------------------------------------------------------------------------
  78. ;;;; Domains and default values for (some of) the Problem Report fields;
  79. ;;;; constants and definitions.
  80. ;;;;---------------------------------------------------------------------------
  81.  
  82. (defconst gnats::emacs-19p
  83.   (not (or (and (boundp 'epoch::version) epoch::version)
  84.        (string-lessp emacs-version "19")))
  85.   "Is this emacs v19?")
  86.  
  87. ;;; This has to be here rather than at the bottom of this file with
  88. ;;; the other utility functions because it is used by
  89. ;;; gnats::get-config, which is called when send-pr.el is being
  90. ;;; loaded (see the "defconst" below), before the whole file has been
  91. ;;; loaded.
  92.  
  93. (defun gnats::find-safe-default-directory (&optional buffer)
  94. "If the directory referred to by `default-directory' for the current
  95. buffer (or for optional argument BUFFER) does not exist, set it to the home
  96. directory of the current user if that exists, or to `/'.
  97.  
  98. Returns the final value of default-directory in the buffer."
  99.   (let ((homedir (expand-file-name "~/")))
  100.     (save-excursion
  101.       (if buffer (set-buffer buffer))
  102.       (if (not (file-exists-p default-directory))
  103.       (if (file-exists-p homedir)
  104.           (setq default-directory homedir)
  105.         (setq default-directory "/")))
  106.       default-directory)))
  107.  
  108. ;;; These may be changed during configuration/installation or by the individual
  109. ;;; user in his/her .emacs file.
  110. ;;;
  111. (defun gnats::get-config (var)
  112.   (let ((shell-file-name "/bin/sh")
  113.     (buf (generate-new-buffer " *GNATS config*"))
  114.     ret)
  115.     (save-excursion
  116.       (set-buffer buf)
  117.       (shell-command-on-region
  118.        (point-min) (point-max)
  119.        (concat ". " gnats:root "/gnats-adm/config; echo $" var ) t)
  120.       (goto-char (point-min))
  121.       ; We have to use get-buffer, since shell-command-on-region will wipe
  122.       ; out the buffer if there's no output from the command.
  123.       (if (or (not (get-buffer "*Shell Command Output*"))
  124.           (looking-at "/bin/sh:\\|\.:\\|\n"))
  125.       (setq ret nil)
  126.     (setq ret (buffer-substring (point-min) (- (point-max) 1)))))
  127.     (if (and ret (string-equal ret "")) (setq ret nil))
  128.     (kill-buffer buf)
  129.     ret))
  130.  
  131. ;; const because it must match the script's value
  132. ;; XEmacs, former value was (or (gnats::get-config "DATADIR") "/usr/share")
  133. (defconst send-pr:datadir (substring (locate-data-directory "gnats") 0 -6)
  134.   "*Where the `gnats' subdirectory containing category lists lives.")
  135.  
  136. (defvar send-pr::sites nil
  137.   "List of GNATS support sites; computed at runtime.")
  138. (defvar send-pr:default-site
  139.   (or (gnats::get-config "GNATS_SITE") "xemacs.org")
  140.   "Default site to send bugs to.")
  141. (defvar send-pr:::site send-pr:default-site
  142.   "The site to which a problem report is currently being submitted, or NIL
  143. if using the default site (buffer local).")
  144.  
  145. (defvar send-pr:::categories nil
  146.   "Buffer local list of available categories, derived at runtime from
  147. send-pr:::site and send-pr::category-alist.")
  148. (defvar send-pr::category-alist nil
  149.   "Alist of GNATS support sites and the categories supported at each; computed
  150. at runtime.")
  151.  
  152. ;;; Ideally we would get all the following values from a central database
  153. ;;; during runtime instead of having them here in the code.
  154. ;;;
  155. (defconst send-pr::fields
  156.   (` (("Category" send-pr::set-categories
  157.        (, (or (gnats::get-config "DEFAULT_CATEGORY") nil)) enum)
  158.       ("Class" (("sw-bug") ("doc-bug") ("change-request") ("support"))
  159.        (, (or (gnats::get-config "DEFAULT_CLASS") 0)) enum)
  160.       ("Confidential" (("yes") ("no"))
  161.        (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 1)) enum)
  162.       ("Severity" (("non-critical") ("serious") ("critical"))
  163.        (, (or (gnats::get-config "DEFAULT_SEVERITY") 1)) enum)
  164.       ("Priority" (("low") ("medium") ("high"))
  165.        (, (or (gnats::get-config "DEFAULT_PRIORITY") 1)) enum)
  166.       ("Release" nil
  167.        (, (or (gnats::get-config "DEFAULT_RELEASE") "gnats-3.101"))
  168.        text)
  169.       ("Submitter-Id" nil
  170.        (, (or (gnats::get-config "SUBMITTER") "xSUBMITTERx")) text)
  171.       ("Synopsis" nil nil text
  172.        (lambda (a b c) (gnats::set-mail-field "Subject" c)))))
  173.   "AList, keyed on the name of the field, of:
  174. 1) The field name.
  175. 2) The list of completions.  This can be a list, a function to call, or nil.
  176. 3) The default value.
  177. 4) The type of the field.
  178. 5) A sub-function to call when changed.")
  179.  
  180. (defvar gnats::fields nil)
  181.  
  182. (defmacro gnats::push (i l)
  183.   (` (setq (, l) (cons (,@ (list i l))))))
  184.  
  185. (defun send-pr::set-categories (&optional arg)
  186.   "Get the list of categories for the current site out of
  187. send-pr::category-alist if there or from send-pr if not.  With arg, force
  188. update."
  189.   ;;
  190.   (let ((entry (assoc send-pr:::site send-pr::category-alist)))
  191.     (or (and entry (null arg))
  192.     (let ((oldpr (getenv "GNATS_ROOT")) cats)
  193.       (send-pr::set-sites arg)
  194.       (setenv "GNATS_ROOT" gnats:root)
  195.       (setq cats (gnats::get-value-from-shell
  196.               "send-pr" "-CL" send-pr:::site))
  197.       (setenv "GNATS_ROOT" oldpr)
  198.       (if entry (setcdr entry cats)
  199.         (setq entry (cons send-pr:::site cats))
  200.         (gnats::push entry send-pr::category-alist))))
  201.     (setq send-pr:::categories (cdr entry))))
  202.  
  203. (defun send-pr::set-sites (&optional arg)
  204.   "Get the list of sites (by listing the contents of DATADIR/gnats) and assign
  205. it to send-pr::sites.  With arg, force update."
  206.   (or (and (null arg) send-pr::sites)
  207.       (progn
  208.     (setq send-pr::sites nil)
  209.     (mapcar
  210.      (function
  211.       (lambda (file)
  212.         (or (memq t (mapcar (function (lambda (x) (string= x file)))
  213.                 '("." ".." "pr-edit" "pr-addr")))
  214.         (not (file-readable-p file))
  215.         (gnats::push (list (file-name-nondirectory file))
  216.                 send-pr::sites))))
  217.      (directory-files (format "%sgnats" send-pr:datadir) t))
  218.     (setq send-pr::sites (reverse send-pr::sites)))))
  219.  
  220. (defconst send-pr::pr-buffer-name "*send-pr*"
  221.   "Name of the temporary buffer, where the problem report gets composed.")
  222.  
  223. (defconst send-pr::err-buffer-name "*send-pr-error*"
  224.   "Name of the temporary buffer, where send-pr error messages appear.")
  225.  
  226. (defvar send-pr:::err-buffer nil
  227.   "The error buffer used by the current PR buffer.")
  228.  
  229. (defvar send-pr:::spawn-to-send nil
  230.   "Whether or not send-pr-mode should spawn a send-pr process to send the PR.")
  231.  
  232. (defconst gnats::indent 17 "Indent for formatting the value.")
  233.  
  234. ;;;;---------------------------------------------------------------------------
  235. ;;;; `send-pr' - command for creating and sending of problem reports
  236. ;;;;---------------------------------------------------------------------------
  237.  
  238. ;;;###autoload
  239. (fset 'send-pr 'send-pr:send-pr)
  240. ;;;###autoload
  241. (defun send-pr:send-pr (&optional site)
  242.   "Create a buffer and read in the result of `send-pr -P'.
  243. When finished with editing the problem report use \\[send-pr:submit-pr]
  244. to send the PR with `send-pr -b -f -'."
  245.   ;;
  246.   (interactive
  247.    (if current-prefix-arg
  248.        (list (completing-read "Site: " (send-pr::set-sites 'recheck) nil t
  249.                   send-pr:default-site))))
  250.   (or site (setq site send-pr:default-site))
  251.   (let ((buf (get-buffer send-pr::pr-buffer-name)))
  252.     (if (or (not buf)
  253.         (progn (switch-to-buffer buf)
  254.            (cond ((or (not (buffer-modified-p buf))
  255.                   (y-or-n-p "Erase previous problem report? "))
  256.               (erase-buffer) t)
  257.              (t nil))))
  258.     (send-pr::start-up site))))
  259.  
  260. (defun send-pr::start-up (site)
  261.   (switch-to-buffer (get-buffer-create send-pr::pr-buffer-name))
  262.   (setq default-directory (expand-file-name "~/"))
  263.   (auto-save-mode auto-save-default)
  264.   (let ((oldpr (getenv "GNATS_ROOT"))
  265.     (case-fold-search nil))
  266.     (setenv "GNATS_ROOT" gnats:root)
  267.     (send-pr::insert-template site)
  268.     (setenv "GNATS_ROOT" oldpr)
  269.     (goto-char (point-min))
  270.     (if (looking-at "send-pr:")
  271.     (cond ((looking-at "send-pr: .* does not have a categories list")
  272.            (setq send-pr::sites nil)
  273.            (error "send-pr: the GNATS site %s does not have a categories list" site))
  274.           (t (error (buffer-substring (point-min) (point-max)))))
  275.       (save-excursion
  276.     ;; Clear cruft inserted by bdamaged .cshrcs
  277.     (goto-char 1)
  278.     ;; XEmacs change
  279.     (when (re-search-forward "^SEND-PR:" nil t)
  280.       (delete-region 1 (match-beginning 0))))))
  281.   (set-buffer-modified-p nil)
  282.   (send-pr:send-pr-mode)
  283.   (setq send-pr:::site site)
  284.   (setq send-pr:::spawn-to-send t)
  285.   (send-pr::set-categories)
  286.   (if (null send-pr:::categories)
  287.       (progn
  288.     (and send-pr:::err-buffer (kill-buffer send-pr:::err-buffer))
  289.     (kill-buffer nil)
  290.     (message "send-pr: no categories found"))
  291.     (or (stringp mail-default-reply-to)
  292.     (setq mail-default-reply-to (getenv "REPLYTO")))
  293.     (and mail-default-reply-to
  294.      (gnats::set-mail-field "Reply-To" mail-default-reply-to))
  295.     (and mail-self-blind
  296.      (gnats::set-mail-field "BCC" (user-login-name)))
  297.     (mapcar 'send-pr::maybe-change-field send-pr::fields)
  298.     (gnats::position-on-field "Description")
  299.     (message (substitute-command-keys
  300.           "To send the problem report use: \\[send-pr:submit-pr]"))))
  301.  
  302. (defvar send-pr::template-alist nil
  303.   "An alist containing the output of send-pr -P <sitename> for various sites.")
  304.  
  305. (defun send-pr::insert-template (site)
  306.   (let ((elt (assoc site send-pr::template-alist)))
  307.     (if elt
  308.     (save-excursion (insert (cdr elt)))
  309.       (setenv "DATADIR" send-pr:datadir)
  310.       (call-process "send-pr" nil t nil "-P" site)
  311.       (save-excursion
  312.     (setq send-pr::template-alist
  313.           (cons (cons site (buffer-substring (point-min) (point-max)))
  314.             send-pr::template-alist))))))
  315.  
  316. (fset 'do-send-pr 'send-pr:submit-pr)    ;backward compat
  317. (defun send-pr:submit-pr ()
  318.   "Pipe the contents of the buffer *send-pr* to `send-pr -f -.' unless this
  319. buffer was loaded with emacsclient, in which case save the buffer and exit."
  320.   ;;
  321.   (interactive)
  322.   (cond
  323.    ((and (boundp 'server-buffer-clients)
  324.      server-buffer-clients)
  325.     (let ((buffer (current-buffer))
  326.       (version-control nil) (buffer-backed-up nil))
  327.       (save-buffer buffer)
  328.       (kill-buffer buffer)
  329.       (server-buffer-done buffer)))
  330.    (send-pr:::spawn-to-send
  331.     (or (and send-pr:::err-buffer
  332.          (buffer-name send-pr:::err-buffer))
  333.     (setq send-pr:::err-buffer
  334.           (get-buffer-create send-pr::err-buffer-name)))
  335.     (let ((err-buffer send-pr:::err-buffer) mesg ok)
  336.       (save-excursion (set-buffer err-buffer) (erase-buffer))
  337.       (message "running send-pr...")
  338.       (let ((oldpr (getenv "GNATS_ROOT")))
  339.     (setenv "GNATS_ROOT" gnats:root)
  340.     (setenv "DATADIR" send-pr:datadir)
  341.     (call-process-region (point-min) (point-max) "send-pr"
  342.                  nil err-buffer nil send-pr:::site
  343.                  "-b" "-f" "-")
  344.     (setenv "GNATS_ROOT" oldpr))
  345.       (message "running send-pr...done")
  346.       ;; stupidly we cannot check the return value in EMACS 18.57, thus we need
  347.       ;; this kluge to find out whether send-pr succeeded.
  348.       (if (save-excursion
  349.         (set-buffer err-buffer)
  350.         (goto-char (point-min))
  351.         (setq mesg (buffer-substring (point-min) (- (point-max) 1)))
  352.         (search-forward "problem report sent" nil t))
  353.       (progn (message mesg)
  354.          (kill-buffer err-buffer)
  355.          (delete-auto-save-file-if-necessary)
  356.          (set-buffer-modified-p nil)
  357.          (bury-buffer))
  358.     (pop-to-buffer err-buffer))
  359.     ))
  360.    (t
  361.     (save-buffer)
  362.     (message "Exit emacs to send the PR."))))
  363.    
  364. ;;;;---------------------------------------------------------------------------
  365. ;;;; send-pr:send-pr-mode mode
  366. ;;;;---------------------------------------------------------------------------
  367.  
  368. (defvar send-pr-mode-map
  369.   (let ((map (make-sparse-keymap)))
  370.     (define-key map "\C-c\C-c" 'send-pr:submit-pr)
  371.     (define-key map "\C-c\C-f" 'gnats:change-field)
  372.     (define-key map "\M-n" 'gnats:next-field)
  373.     (define-key map "\M-p" 'gnats:previous-field)
  374.     (define-key map "\C-\M-f" 'gnats:forward-field)
  375.     (define-key map "\C-\M-b" 'gnats:backward-field)
  376.     map)
  377.   "Keymap for send-pr mode.")
  378.  
  379. (defconst gnats::keyword "^>\\([-a-zA-Z]+\\):")
  380. (defconst gnats::before-keyword "[ \t\n\f]*[\n\f]+>\\([-a-zA-Z]+\\):")
  381. (defconst gnats::after-keyword "^>\\([-a-zA-Z]+\\):[ \t\n\f]+")
  382.  
  383. ;;;###autoload
  384. (fset 'send-pr-mode 'send-pr:send-pr-mode)
  385. ;;;###autoload
  386. (defun send-pr:send-pr-mode ()
  387.   "Major mode for submitting problem reports.
  388. For information about the form see gnats(1) and send-pr(1).
  389. Special commands: \\{send-pr-mode-map}
  390. Turning on send-pr-mode calls the value of the variable send-pr-mode-hook,
  391. if it is not nil."
  392.   (interactive)
  393.   (gnats::patch-exec-path)
  394.   (put 'send-pr:send-pr-mode 'mode-class 'special)
  395.   (kill-all-local-variables)
  396.   (setq major-mode 'send-pr:send-pr-mode)
  397.   (setq mode-name "send-pr")
  398.   (use-local-map send-pr-mode-map)
  399.   (set-syntax-table text-mode-syntax-table)
  400.   (setq local-abbrev-table text-mode-abbrev-table)
  401.   (setq buffer-offer-save t)
  402.   (make-local-variable 'send-pr:::site)
  403.   (make-local-variable 'send-pr:::categories)
  404.   (make-local-variable 'send-pr:::err-buffer)
  405.   (make-local-variable 'send-pr:::spawn-to-send)
  406.   (make-local-variable 'paragraph-separate)
  407.   (setq paragraph-separate (concat (default-value 'paragraph-separate)
  408.                    "\\|" gnats::keyword "[ \t\n\f]*$"))
  409.   (make-local-variable 'paragraph-start)
  410.   (setq paragraph-start (concat (default-value 'paragraph-start)
  411.                 "\\|" gnats::keyword))
  412.   (run-hooks 'send-pr-mode-hook)
  413.   t)
  414.  
  415. ;;;;---------------------------------------------------------------------------
  416. ;;;; Functions to read and replace field values.
  417. ;;;;---------------------------------------------------------------------------
  418.  
  419. (defun gnats::position-on-field (field &optional quiet)
  420.   (goto-char (point-min))
  421.   (if (not (re-search-forward (concat "^>" field ":") nil t))
  422.       (if quiet
  423.       nil
  424.     (error "Field `>%s:' not found." field))
  425.     (re-search-forward "[ \t\n\f]*")
  426.     (if (looking-at gnats::keyword)
  427.     (backward-char 1))
  428.     t))
  429.  
  430. (defun gnats::mail-position-on-field (field)
  431.   (let (end
  432.     (case-fold-search t))
  433.     (goto-char (point-min))
  434.     (re-search-forward "^$")
  435.     (setq end (match-beginning 0))
  436.     (goto-char (point-min))
  437.     (if (not (re-search-forward (concat "^" field ":") end 'go-to-end))
  438.     (insert field ": \n")
  439.       (re-search-forward "[ \t\n\f]*"))
  440.     (skip-chars-backward "\n")
  441.     t))
  442.  
  443. (defun gnats::field-contents (field &optional elem move)
  444.   (let (pos)
  445.     (unwind-protect
  446.     (save-excursion
  447.       (if (not (gnats::position-on-field field t))
  448.           nil
  449.         (setq pos (point-marker))
  450.         (if (or (looking-at "<.*>$") (eolp))
  451.         t
  452.           (looking-at ".*$")    ; to set match-{beginning,end}
  453.           (gnats::nth-word 
  454.            (buffer-substring (match-beginning 0) (match-end 0))
  455.            elem))))
  456.       (and move pos (goto-char pos)))))
  457.  
  458. (defun gnats::functionp (thing)
  459.   (or (and (symbolp thing) (fboundp thing))
  460.       (and (listp thing) (eq (car thing) 'lambda))))
  461.  
  462. (defun gnats::field-values (field)
  463.   "Return the possible (known) values for field FIELD."
  464.   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
  465.            send-pr::fields))
  466.      (thing (elt (assoc field fields) 1)))
  467.     (cond ((gnats::functionp thing) (funcall thing))
  468.       ((listp thing) thing)
  469.       (t (error "ACK")))))
  470.  
  471. (defun gnats::field-default (field)
  472.   "Return the default value for field FIELD."
  473.   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
  474.            send-pr::fields))
  475.      (thing (elt (assoc field fields) 2)))
  476.     (cond ((stringp thing) thing)
  477.       ((null thing) "")
  478.       ((numberp thing) (car (elt (gnats::field-values field) thing)))
  479.       ((gnats::functionp thing)
  480.        (funcall thing (gnats::field-contents field)))
  481.       ((eq thing t) (gnats::field-contents field))
  482.       (t (error "ACK")))))
  483.  
  484. (defun gnats::field-type (field)
  485.   "Return the type of field FIELD."
  486.   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
  487.            send-pr::fields))
  488.      (thing (elt (assoc field fields) 3)))
  489.     thing))
  490.  
  491. (defun gnats::field-action (field)
  492.   "Return the extra handling function for field FIELD."
  493.   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
  494.            send-pr::fields))
  495.      (thing (elt (assoc field fields) 4)))
  496.     (cond ((null thing) 'ignore)
  497.       ((gnats::functionp thing) thing)
  498.       (t (error "ACK")))))
  499.  
  500. ;;;;---------------------------------------------------------------------------
  501. ;;;; Point movement functions
  502. ;;;;---------------------------------------------------------------------------
  503.  
  504. (or (fboundp 'defsubst) (fset 'defsubst 'defun))
  505.  
  506. (defun send-pr::maybe-change-field (field)
  507.   (setq field (car field))
  508.   (let ((thing (gnats::field-contents field)))
  509.     (and thing (eq t thing)
  510.      (not (eq 'multi-text (gnats::field-type field)))
  511.      (gnats:change-field field))))
  512.     
  513. (defun gnats:change-field (&optional field default)
  514.   "Change the value of the field containing the cursor.  With arg, ask the
  515. user for the field to change.  From a program, the function takes optional
  516. arguments of the field to change and the default value to use."
  517.   (interactive)
  518.   (or field current-prefix-arg (setq field (gnats::current-field)))
  519.   (or field
  520.       (setq field
  521.         (completing-read "Field: "
  522.                  (if (eq major-mode 'gnats:gnats-mode)
  523.                  gnats::fields
  524.                    send-pr::fields)
  525.                  nil t)))
  526.   (gnats::position-on-field field)
  527.   (sit-for 0)
  528.   (let* ((old (gnats::field-contents field))
  529.      new)
  530.     (if (null old)
  531.     (error "ACK")
  532.       (if (or (interactive-p) t)
  533.       (let ((prompt (concat ">" field ": "))
  534.         (domain (gnats::field-values field))
  535.         (type (gnats::field-type field)))
  536.         (or default (setq default (gnats::field-default field)))
  537.         (setq new
  538.           (if (eq type 'enum)
  539.               (completing-read prompt domain nil t 
  540.                        (if gnats::emacs-19p (cons default 0)
  541.                      default))
  542.             (read-string prompt (if gnats::emacs-19p (cons default 1)
  543.                       default)))))
  544.     (setq new default))
  545.       (gnats::set-field field new)
  546.       (funcall (gnats::field-action field) field old new)
  547.       new)))
  548.  
  549. (defun gnats::set-field (field value)
  550.   (save-excursion
  551.     (gnats::position-on-field field)
  552.     (delete-horizontal-space)
  553.     (looking-at ".*$")
  554.     (replace-match
  555.      (concat (make-string (- gnats::indent (length field) 2) ?\40 ) value) t)))
  556.  
  557. (defun gnats::set-mail-field (field value)
  558.   (save-excursion
  559.     (gnats::mail-position-on-field field)
  560.     (delete-horizontal-space)
  561.     (looking-at ".*$")
  562.     (replace-match (concat " " value) t)))
  563.   
  564. (defun gnats::before-keyword (&optional where)
  565.   "Returns t if point is in some white space before a keyword.
  566. If where is nil, then point is not changed; if where is t then point is moved
  567. to the beginning of the keyword, otherwise it is moved to the beginning
  568. of the white space it was in."
  569.   ;;
  570.   (if (looking-at gnats::before-keyword)
  571.       (prog1 t
  572.     (cond  ((eq where t)
  573.         (re-search-forward "^>") (backward-char))
  574.            ((not (eq where nil))
  575.         (re-search-backward "[^ \t\n\f]") (forward-char))))
  576.        nil))
  577.  
  578. (defun gnats::after-keyword (&optional where)
  579.   "Returns t if point is in some white space after a keyword.
  580. If where is nil, then point is not changed; if where is t then point is moved
  581. to the beginning of the keyword, otherwise it is moved to the end of the white
  582. space it was in."
  583.   ;;
  584.   (if (gnats::looking-after gnats::after-keyword)
  585.       (prog1 t
  586.     (cond  ((eq where t)
  587.         (re-search-backward "^>"))
  588.            ((not (eq where nil))
  589.         (re-search-forward "[^ \t\n\f]") (backward-char))))
  590.        nil))
  591.  
  592. (defun gnats::in-keyword (&optional where)
  593.   "Returns t if point is within a keyword.
  594. If where is nil, then point is not changed; if where is t then point is moved
  595. to the beginning of the keyword."
  596.   ;;
  597.   (let ((old-point (point-marker)))
  598.     (beginning-of-line)
  599.     (cond ((and (looking-at gnats::keyword)
  600.            (< old-point (match-end 0)))
  601.        (prog1 t
  602.          (if (eq where t) 
  603.          t
  604.            (goto-char old-point))))
  605.       (t (goto-char old-point)
  606.          nil))))
  607.  
  608. (defun gnats::forward-bofield ()
  609.   "Moves point to the beginning of a field. Assumes that point is in the
  610. keyword." 
  611.   ;;
  612.   (if (re-search-forward "[ \t\n\f]+[^ \t\n\f]" (point-max) '-)
  613.       (backward-char)
  614.     t))
  615.  
  616. (defun gnats::backward-eofield ()
  617.   "Moves point to the end of a field. Assumes point is in the keyword."
  618.   ;;
  619.   (if (re-search-backward "[^ \t\n\f][ \t\n\f]+" (point-min) '-)
  620.       (forward-char)
  621.     t))
  622.  
  623. (defun gnats::forward-eofield ()
  624.   "Moves point to the end of a field. Assumes that point is in the field." 
  625.   ;;
  626.   ;; look for the next field
  627.   (if (re-search-forward gnats::keyword (point-max) '-) 
  628.       (progn (beginning-of-line) (gnats::backward-eofield))
  629.   (re-search-backward "[^ \t\n\f][ \t\n\f]*" (point-min) '-)
  630.   (forward-char)))
  631.  
  632. (defun gnats::backward-bofield ()
  633.   "Moves point to the beginning of a field. Assumes that point is in the
  634. field." 
  635.   ;;
  636.   ;;look for previous field
  637.   (if (re-search-backward gnats::keyword (point-min) '-)
  638.       (gnats::forward-bofield)
  639.     t))
  640.  
  641.  
  642. (defun gnats:forward-field ()
  643.   "Move point forward to the end of the field or to the beginning of the next
  644. field."
  645.   ;;
  646.   (interactive)
  647.   (if (or (gnats::before-keyword t) (gnats::in-keyword t)
  648.       (gnats::after-keyword t))
  649.     (gnats::forward-bofield)
  650.     (gnats::forward-eofield)))
  651.  
  652. (defun gnats:backward-field ()
  653.   "Move point backward to the beginning/end of a field."
  654.   ;;
  655.   (interactive)
  656.   (backward-char)
  657.   (if (or (gnats::before-keyword t) (gnats::in-keyword t)
  658.       (gnats::after-keyword t))
  659.       (gnats::backward-eofield)
  660.     (gnats::backward-bofield)))
  661.  
  662. (defun gnats:next-field ()
  663.   "Move point to the beginning of the next field."
  664.   ;;
  665.   (interactive)
  666.   (if (or (gnats::before-keyword t) (gnats::in-keyword t)
  667.       (gnats::after-keyword t))
  668.       (gnats::forward-bofield)
  669.     (if (re-search-forward gnats::keyword (point-max) '-)
  670.     (gnats::forward-bofield)
  671.       t)))
  672.  
  673. (defun gnats:previous-field ()
  674.   "Move point to the beginning of the previous field."
  675.   ;;
  676.   (interactive)
  677.   (backward-char)
  678.   (if (or (gnats::after-keyword t) (gnats::in-keyword t)
  679.       (gnats::before-keyword t))
  680.       (progn (re-search-backward gnats::keyword (point-min) '-)
  681.          (gnats::forward-bofield))
  682.     (gnats::backward-bofield)))
  683.  
  684. (defun gnats:beginning-of-field ()
  685.   "Move point to the beginning of the current field."
  686.   (interactive)
  687.   (cond ((gnats::in-keyword t)
  688.      (gnats::forward-bofield))
  689.     ((gnats::after-keyword 0))
  690.     (t
  691.      (gnats::backward-bofield))))
  692.  
  693. (defun gnats::current-field ()
  694.   (save-excursion
  695.     (if (cond ((or (gnats::in-keyword t) (gnats::after-keyword t))
  696.            (looking-at gnats::keyword))
  697.           ((re-search-backward gnats::keyword nil t)))
  698.     (buffer-substring (match-beginning 1) (match-end 1))
  699.       nil)))
  700.  
  701. ;;;;---------------------------------------------------------------------------
  702. ;;;; Support functions
  703. ;;;;---------------------------------------------------------------------------
  704.  
  705. (defun gnats::looking-after (regex)
  706.   "Returns t if point is after regex."
  707.   ;;
  708.   (let* ((old-point (point))
  709.      (start (if (eobp)
  710.            old-point
  711.          (forward-char) (point))))
  712.     (cond ((re-search-backward regex (point-min) t)
  713.        (goto-char old-point)
  714.        (cond ((eq (match-end 0) start)
  715.           t))))))
  716.  
  717. (defun gnats::nth-word (string &optional elem)
  718.   "Returns the elem-th word of the string.
  719. If elem is nil, then the first wort is returned, if elem is 0 then
  720. the whole string is returned."
  721.    ;;
  722.   (if (integerp elem)
  723.       (cond ((eq elem 0) string)
  724.         ((eq elem 1) (gnats::first-word string))
  725.         ((equal string "") "")
  726.         ((>= elem 2) 
  727.          (let ((i 0) (value ""))
  728.            (setq string        ; strip leading blanks
  729.              (substring string (or (string-match "[^ \t]" string) 0)))
  730.            (while (< i elem)
  731.          (setq value 
  732.                (substring string 0 
  733.                   (string-match "[ \t]*$\\|[ \t]+" string)))
  734.          (setq string 
  735.                (substring string (match-end 0)))
  736.          (setq i (+ i 1)))
  737.            value)))
  738.     (gnats::first-word string)))
  739.  
  740. (defun gnats::first-word (string)
  741.   (setq string 
  742.     (substring string (or (string-match "[^ \t]" string) 0)))
  743.   (substring string 0 (string-match "[ \t]*$\\|[ \t]+" string)))
  744.  
  745. ;;;;---------------------------------------------------------------------------
  746.  
  747. (defun gnats::patch-exec-path ()
  748.   ;;
  749.   "Replaces `//' by `/' in `exec-path'."
  750.   ;;
  751.   ;(make-local-variable 'exec-path)
  752.   (let ((err-buffer (get-buffer-create " *gnats::patch-exec-path*"))
  753.     (ret))
  754.     (setq exec-path (save-excursion (set-buffer err-buffer)
  755.                     (prin1 exec-path err-buffer)
  756.                     (goto-char (point-min))
  757.                     (while (search-forward "//" nil t)
  758.                       (replace-match "/" nil t))
  759.                     (goto-char (point-min))
  760.                     (setq ret (read err-buffer))
  761.                     (kill-buffer err-buffer)
  762.                     ret
  763.                     ))))
  764.  
  765. (defun gnats::get-value-from-shell (&rest command)
  766.   "Execute shell command to get a list of valid values for `variable'."
  767.   ;;
  768.   (let ((err-buffer (get-buffer-create " *gnats::get-value-from-shell*")))
  769.     (save-excursion
  770.       (set-buffer err-buffer)
  771.       (unwind-protect
  772.       (condition-case var
  773.           (progn
  774.         (apply 'call-process
  775.                (car command) nil err-buffer nil (cdr command))
  776.         (goto-char (point-min))
  777.         (if (looking-at "[-a-z]+: ")
  778.             (error (buffer-substring (point-min) (point-max))))
  779.         (read err-buffer))
  780.         (error nil))
  781.     (kill-buffer err-buffer)))))
  782.  
  783. (or (fboundp 'setenv)
  784.     (defun setenv (variable &optional value)
  785.       "Set the value of the environment variable named VARIABLE to VALUE.
  786. VARIABLE should be a string.  VALUE is optional; if not provided or is
  787. `nil', the environment variable VARIABLE will be removed.  
  788. This function works by modifying `process-environment'."
  789.       (interactive "sSet environment variable: \nsSet %s to value: ")
  790.       (if (string-match "=" variable)
  791.       (error "Environment variable name `%s' contains `='" variable)
  792.     (let ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
  793.           (case-fold-search nil)
  794.           (scan process-environment))
  795.       (while scan
  796.         (cond
  797.          ((string-match pattern (car scan))
  798.           (if (eq nil value)
  799.           (setq process-environment (delq (car scan)
  800.                           process-environment))
  801.         (setcar scan (concat variable "=" value)))
  802.           (setq scan nil))
  803.          ((null (setq scan (cdr scan)))
  804.           (setq process-environment
  805.             (cons (concat variable "=" value)
  806.               process-environment)))))))))
  807.  
  808. ;;;; end of send-pr.el
  809.